home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacTech 1 to 12
/
MacTech-vol-1-12.toast
/
Tools
/
Alpha 6.51b13 ƒ
/
Tcl
/
SystemCode
/
getVarValue.tcl
< prev
next >
Wrap
Text File
|
1996-08-15
|
6KB
|
195 lines
#############################################################################
# Report the current value of a global variable, chosen interactively
# from a list of all active variables.
#
# If the variable is an array, or its value is too big to fit in an
# alertnote, then its contents are listed in a new window, otherwise
# the variable's value is displayed in an alertnote.
#
proc getVarValue {} {
set def [getText [getPos] [selEnd]]
set var [listpick -p {Which var?} -L $def [lsort -ignore [info globals]]]
if {![string length $var]} return
showVarValue $var
}
proc showVarValue {var} {
global $var
if {![catch {set $var} value]} {
if {![catch {alertnote "'$var' = $value"}]} {
return
} else {
new -n "* $var *"
insertText "'$var' = $value"
}
} else {
new -n "* $var *"
listArray $var
}
goto 0
# if 'shrinkWindow' is loaded, call it to trim the output window.
catch {shrinkWindow 2}
set win [car [winNames -f]]
setWinInfo -w $win dirty 0
setWinInfo -w $win read-only 1
}
#############################################################################
# List the name and value of each element of the array $arrName.
# (Convenient to use as a shell command.)
#
proc listArray {arrName} {
global $arrName
set lines {}
if {![catch {info vars $arrName}]} {
foreach nm [array names $arrName] {
set val [expr \$$arrName\($nm\)]
append lines "\r\"$nm\"\t\{$val\}"
}
insertText $lines
} else {
alertnote "\"$arrName\" doesn't exist in this context"
}
}
#############################################################################
# Write out the active definition of the proc $procName.
# (Convenient to use as a shell command.)
#
proc listProc {procName} {
set lines {}
if {![catch {info procs "*$procName*"} procList]} {
foreach p $procList {
set pargs [info args $p]
set arglist {}
foreach a $pargs {
if {[info default $p $a def]} {
append arglist " {$a $def}"
} else {
append arglist " $a"
}
}
append lines "\rproc $p {[string trim $arglist]} {"
append lines [info body $p]
append lines "}\r"
}
insertText $lines
}
}
#############################################################################
# Adjust the dimensions of the current window to match the length (and
# optionally the width) of the text that it contains. If shrinkWidth is
# omitted or set to zero, then only the height of the window is adjusted.
# If it's set to 1, then the width is adjusted to accomodate the widest
# line in the file; if it's set to 2, then the width is set based on only
# the currently displayed lines (moves insertion onto the screen, as a
# side effect.)
proc shrinkWindow {{shrinkWidth 0}} {
global defHeight defWidth
# These constants work for 9-pt Monaco type
set lineht 11
set htoff 22
set chwd 6
set choff 20
set wd [lindex [getGeometry] 2]
set ht [lindex [getGeometry] 3]
set top [lindex [getGeometry] 1]
set left [lindex [getGeometry] 0]
set mxht [expr [lindex [getMainDevice] 3] - $top - 5 -15]
set mxwd [expr [lindex [getMainDevice] 2] - $left - 5]
set mnht 120
set mnwd 200
set htWd [fileHtWd $shrinkWidth]
set lines [lindex $htWd 0]
set chars [lindex $htWd 1]
if {$lines <= 1} then {set lines 10}
if {$lines > 0} {
set ht [expr $htoff + ( $lineht * (1 + $lines)) ]
} elseif {$ht > $defHeight} {
set ht $defHeight
}
if {$chars > 0} {
set wd [expr $choff + ( $chwd * (2 + $chars)) ]
} elseif {$wd > $defWidth} {
set wd $defWidth
}
if {$ht > $mxht} then {set ht $mxht}
if {$wd > $mxwd} then {set wd $mxwd}
if {$ht < $mnht} then {set ht $mnht}
if {$wd < $mnwd} then {set wd $mnwd}
sizeWin $wd $ht
}
#############################################################################
# Return the number of lines and the maximum number of characters in any
# line of a file. It would be nice if there was a built-in command to
# do this (i.e., compiled C code) because this is a pretty slow way to
# get the maximum line width.
proc fileHtWd {{checkWidth 0}} {
set text [getText 0 [maxPos]]
getWinInfo arr
set tabw [expr $arr(tabsize) - 1]
set lines [split $text "\r"]
set nlines [llength $lines]
if {$checkWidth > 1} {
set lines [eval lrange \$lines [displayedLines]]
}
set llen 0
if {$checkWidth > 0} {
foreach line $lines {
regsub { +∞.*$} $line {} line
regsub { } $line { } line
set len [string length $line]
if {[set ntab [llength [split $line "\t"]]] > 1} {
set len [expr $len + $tabw*($ntab-1)]
}
if { $len > $llen} {
set llen $len
}
}
}
# alertnote "Text Height : $nlines ; Text Width : $llen "
return [list $nlines $llen]
}
# Report what range of lines are displayed in any window.
# (A side effect is that the insertion point is moved to the
# top of the window, if it was previously off-screen)
#
proc displayedLines {{window {}}} {
if {$window == {}} { set window [car [winNames -f]] }
bringToFront $window
set oldPos [getPos]
moveInsertionHere
set top [getPos]
set first [lindex [posToRowCol $top] 0]
moveInsertionHere -last
set bottom [getPos]
set last [lindex [posToRowCol $bottom] 0]
if {$oldPos < $top || $oldPos > $bottom} {
goto $top
} else {
goto $oldPos
}
return [list $first $last]
}